VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTicTacToe"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

#Const PreferWinningMove = True

Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function PolyPolyline Lib "gdi32.dll" (ByVal hdc As Long, ByRef lppt As POINTAPI, ByRef lpdwPolyPoints As Long, ByVal cCount As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Const NULL_BRUSH As Long = 5

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Implements IGameState

Private Type typeTicTicToeState
 nPlayerJustMoved As Long
 b(8) As Byte
End Type

Private m_t As typeTicTicToeState
Private m_nMoves As Long

Friend Sub CloneFrom(ByRef t As typeTicTicToeState)
m_t = t
End Sub

Private Sub IGameState_ClearUserMoves()
m_nMoves = -1
End Sub

Private Function IGameState_Clone() As IGameState
Dim obj As New clsTicTacToe
obj.CloneFrom m_t
Set IGameState_Clone = obj
End Function

Private Function IGameState_DoMove(ByVal lpData As Long, ByVal nSize As Long) As Boolean
Dim i As Long
'///
If lpData = 0 Or nSize < 1 Then Exit Function
CopyMemory i, ByVal lpData, 1
If m_t.b(i) <> 0 Then Exit Function
'///
m_t.nPlayerJustMoved = (m_t.nPlayerJustMoved And 1&) + 1
m_t.b(i) = m_t.nPlayerJustMoved
IGameState_DoMove = True
End Function

Private Function IGameState_Draw(ByVal bm As cDIBSection, ByVal nWidth As Long, ByVal nHeight As Long) As Boolean
Dim r As RECT
Dim hbr As Long, hpn As Long
Dim i As Long, j As Long
Dim p(63) As POINTAPI, m2(31) As Long, m As Long
'///
hbr = CreateSolidBrush(GetSysColor(vbButtonFace And &HFF&))
r.Right = nWidth
r.Bottom = nHeight
FillRect bm.hdc, r, hbr
DeleteObject hbr
'///
If nWidth > nHeight Then nWidth = nHeight
nWidth = nWidth \ 3
hbr = SelectObject(bm.hdc, GetStockObject(NULL_BRUSH))
hpn = SelectObject(bm.hdc, CreatePen(0, 4, vbBlack))
For i = 0 To 1
 p(i * 4).y = (i + 1) * nWidth
 p(i * 4 + 1).x = 3 * nWidth
 p(i * 4 + 1).y = (i + 1) * nWidth
 p(i * 4 + 2).x = (i + 1) * nWidth
 p(i * 4 + 3).x = (i + 1) * nWidth
 p(i * 4 + 3).y = 3 * nWidth
Next i
m = 4
'///
For j = 0 To 2
 For i = 0 To 2
  Select Case m_t.b(j * 3 + i)
  Case 1 'X
   p(m * 2).x = i * nWidth + 8
   p(m * 2).y = j * nWidth + 8
   p(m * 2 + 1).x = (i + 1) * nWidth - 8
   p(m * 2 + 1).y = (j + 1) * nWidth - 8
   p(m * 2 + 2).x = i * nWidth + 8
   p(m * 2 + 2).y = (j + 1) * nWidth - 8
   p(m * 2 + 3).x = (i + 1) * nWidth - 8
   p(m * 2 + 3).y = j * nWidth + 8
   m = m + 2
  Case 2 'O
   Ellipse bm.hdc, i * nWidth + 8, j * nWidth + 8, (i + 1) * nWidth - 8, (j + 1) * nWidth - 8
  End Select
 Next i
Next j
'///
For i = 0 To 31
 m2(i) = 2
Next i
PolyPolyline bm.hdc, p(0), m2(0), m
'///
SelectObject bm.hdc, hbr
DeleteObject SelectObject(bm.hdc, hpn)
End Function

Private Function IGameState_FilterByRandomFactor(ByVal lpData As Long, ByVal nSize As Long) As Boolean
IGameState_FilterByRandomFactor = True
End Function

Private Function IGameState_GetMoves(bData() As Byte, nSize As Long, ByVal bRespectRandomFactor As Boolean) As Long
Dim i As Long, m As Long
ReDim bData(8)
For i = 0 To 8
 If m_t.b(i) = 0 Then
  bData(m) = i
  m = m + 1
 End If
Next i
'///
nSize = 1
IGameState_GetMoves = m
End Function

'internal function
Friend Function TestRandomMoves(ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal c As Long) As Long
Dim i As Long, j As Long
i = m_t.b(p1)
If i = 0 Then
 i = m_t.b(p2)
 If i = 0 Or i <> m_t.b(p3) Then Exit Function
 TestRandomMoves = p1 Or &H100& Or ((i = c) And &H200&)
Else
 j = m_t.b(p2)
 If j = 0 Then
  If i <> m_t.b(p3) Then Exit Function
  TestRandomMoves = p2 Or &H100& Or ((i = c) And &H200&)
 Else
  If m_t.b(p3) <> 0 Or i <> j Then Exit Function
  TestRandomMoves = p3 Or &H100& Or ((i = c) And &H200&)
 End If
End If
End Function

Private Function IGameState_GetRandomMoves(bData() As Byte, nSize As Long, ByVal bReversed As Boolean) As Boolean
Dim i As Long, m As Long
Dim b(8) As Byte
For i = 0 To 8
 If m_t.b(i) = 0 Then
  b(m) = i
  m = m + 1
 End If
Next i
'///
If m > 0 Then
 ReDim bData(0)
 nSize = 1
 IGameState_GetRandomMoves = True
 '///
 #If PreferWinningMove Then
 If m >= 3 And m <= 7 And Not bReversed Then
  Dim j As Long, c As Long
  c = (m_t.nPlayerJustMoved And 1&) + 1
  '///
  i = TestRandomMoves(0, 1, 2, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(3, 4, 5, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(6, 7, 8, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(0, 3, 6, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(1, 4, 7, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(2, 5, 8, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(0, 4, 8, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  i = TestRandomMoves(2, 4, 6, c): If i And &H200& Then bData(0) = i And &HFF&: Exit Function Else If i Then j = i
  If j Then
   bData(0) = j And &HFF&
   Exit Function
  End If
  '///
 End If
 #End If
 '///
 bData(0) = b(Int(m * Rnd))
End If
End Function

Private Function IGameState_GetResult(ByVal nPlayerJustMoved As Long) As Long
Dim i As Long
'///
i = m_t.b(0)
If i > 0 Then
 If (i = m_t.b(1) And i = m_t.b(2)) Or (i = m_t.b(3) And i = m_t.b(6)) Or (i = m_t.b(4) And i = m_t.b(8)) Then
  IGameState_GetResult = (i = 2 Xor nPlayerJustMoved = 1) And 1&
  Exit Function
 End If
End If
i = m_t.b(4)
If i > 0 Then
 If (i = m_t.b(3) And i = m_t.b(5)) Or (i = m_t.b(1) And i = m_t.b(7)) Or (i = m_t.b(2) And i = m_t.b(6)) Then
  IGameState_GetResult = (i = 2 Xor nPlayerJustMoved = 1) And 1&
  Exit Function
 End If
End If
i = m_t.b(8)
If i > 0 Then
 If (i = m_t.b(6) And i = m_t.b(7)) Or (i = m_t.b(2) And i = m_t.b(5)) Then
  IGameState_GetResult = (i = 2 Xor nPlayerJustMoved = 1) And 1&
  Exit Function
 End If
End If
'///
For i = 0 To 8
 If m_t.b(i) = 0 Then
  IGameState_GetResult = 3
  Exit Function
 End If
Next i
IGameState_GetResult = 2
End Function

Private Function IGameState_GetUserMoves(bData() As Byte, nSize As Long) As Boolean
If m_nMoves < 0 Then Exit Function
ReDim bData(0)
bData(0) = m_nMoves
nSize = 1
IGameState_GetUserMoves = True
End Function

Private Function IGameState_OnMouseDown(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
If nWidth > nHeight Then nWidth = nHeight
nWidth = nWidth \ 3
If nWidth <= 0 Then Exit Function
If x <= 0 Or y <= 0 Then Exit Function
x = x \ nWidth
y = y \ nWidth
If x < 3 And y < 3 Then
 m_nMoves = y * 3 + x
 IGameState_OnMouseDown = 2
End If
End Function

Private Function IGameState_OnMouseMove(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
'do nothing
End Function

Private Function IGameState_OnMouseUp(ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Button As MouseButtonConstants, ByVal Shift As ShiftConstants) As Long
'do nothing
End Function

Private Property Get IGameState_PlayerJustMoved() As Long
IGameState_PlayerJustMoved = m_t.nPlayerJustMoved
End Property
